\ Class PopupMenu.  This version handles pop-up menus in dialogs.  If we
\ ever need one somewhere else, we'll have to define a subclass with
\ different HIT: and NORMAL: methods.


objPtr	THEDLG		class_is dialog+


:class POPUPMENU	super{ menu }

	string+	ITEMTEXT	\ Current text displayed in pop-up box
	int		ITEM#		\ Current item # displayed in pop-up box
	int		BOX#		\ Dialog item# of pop-up box
	int		TITLE#		\ Dialog item# of pop-up title
	rect	TITLERECT
	rect	POPUPBOX
	dicAddr	^DLG		\ Points to owning dialog
	ptr		F-LINK		\ Forward link for chain of pop-up menus
						\  belonging to the one dialog

:m GETTEXT:		( -- addr len )	get: itemText  ;m
:m ITEM#:		( -- item# )	get: item#   ;m
:m PUTITEM#:	( item# -- )	put: item#   ;m
:m PUTTITLE#:	( title# -- )	put: title#  ;m
:m PUT^DLG:		( ^dlg -- )	put: ^dlg  ;m
:m F-LINK:		get: F-link  ;m
:m SET-F-LINK:	put: F-link  ;m
:m BOX#:		get: box#  ;m

private

:m CHKDLG:	\ ( -- b )
	get: ^dlg  this_dlg  =  ;m

:m DT:
	chkDlg: self  0EXIT
	get: itemtext  addr: popUpBox  1 makeint call textBox  ;m

public

:m INIT:	\ ( cfa-list resid box# title# -- )
	put: title#  put: box#  init: super  ;m

:m GETNEW:
	new: itemText  getNew: super
	get: Mhndl  -1 makeint  call InsertMenu  ;m

:m NORMAL:
	savePort  dlgPort
	invert: titleRect
	restPort  ;m


:m DRAWTEXT:
	chkDlg: self  0EXIT
	savePort  dlgPort  dt: self
	restPort  ;m

:m PUTTEXT:		\ ( addr len -- )  Doesn't draw the text, since THIS_DLG
				\ may not be valid.
	put: itemText  ;m


:m DRAWBOX:	\ Called from DRAWBOX, which is called from PUboxProc.
	chkDlg: self  0EXIT
	get: box#  itemHandle: this_dlg  drop
	tempRect ->: popUpBox
	dropShadow: popUpBox
	getBotX: popUpBox  19 -
	getTopY: popUpBox   6 +  moveto  del
	1 1 inset: popUpBox  getBotX: popUpBox  20 -  putBotX: popUpBox
					\ So box outline and down arrow aren't wiped
	dt: self  ;m


:m HIT:
	get: title#  itemHandle: this_dlg drop
	tempRect ->: titleRect
	savePort  dlgPort
	invert: titleRect
	get: theItem  itemHandle: this_dlg  drop	\ Set TempRect to pop-up box
	0
	get: Mhndl
	topint: tempRect  l->g  unpack swap pack
	get: item# 1+  makeint
	call PopUpMenuSelect
	unpack  drop  1-					\ our item# - one less than Toolbox's
	dup 0>=
	IF	dup getitem: super  putText: self  dt: self
		restPort
		dup exec: super					\ Execute action handler
				\ Note: the old item# is still in the item# field, but the
				\ new one is on the stack.  This should be useful when we
				\ need to know if the item# is being changed.
		put: item#
	ELSE
		drop  restPort
	THEN
	normal: self  ;m

:m LINK:	\ ( ^dlg -- )
	-> theDlg
	theDlg  put^dlg: self
	['] PUboxProc  get: box#  setUserProc: theDlg
	PUM-link: theDlg  put: F-link
	^base  set-PUM-link: theDlg  ;m

;class